home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Extra 1996 #3
/
AmigaPlus_CD-ROM-EXTRA_Nr.3.bin
/
aminet-spiele
/
zwei spieler
/
paragon
/
paragon.asc
< prev
next >
Wrap
Text File
|
1992-02-01
|
30KB
|
1,027 lines
'------------------------------------------------------
' PARAGON by Volker Stepprath ©1991 by Depeche Software
'------------------------------------------------------
Set Buffer 110
Dim MAB(10),RAB(8),HF$(14,14,1),KF$(38),SCHALTER(16),FILE$(50)
Global FILE$(),MAB(),KF$(),HF$(),FIN,DISK
Global MA,SPMO_A,STONE_A,ZM_A,ZS_A,TIME_A,PUN_A
Global MB,SPMO_B,STONE_B,ZM_B,ZS_B,TIME_B,PUN_B
Global SWP_AB,SPIELER,SPIELART
Global RAB(),STEINANZAHL,ABXY$,ABXY2$,XALT,YALT,CX,CY,NOCROWN
SOUND=1
GAMES_GFX_TO_RAM
MAINLOOP:
EINSTELLUNG[SOUND]
If STATUS=13 Then INFO : Goto MAINLOOP
FIN=0 : NOCROWN=0 : Clear Key
If MAB(10)>1 and SOUND=1
For I=50 To 0 Step -1
Mvolume I : Wait 2
Next I
Music Off
End If
If MAB(10)=1 and SOUND>1
Music 1
For I=1 To 50
Mvolume I : Wait 3
Next I
End If
SOUND=MAB(10)
If STATUS=11 Then SPIELFELD : STEUERUNG : Goto MAINLOOP
If STATUS=14 Then SPIELFELD : REPLAY : Goto MAINLOOP
If STATUS=15
LADE_SPIELFELD
If STATUS=13
SPIELFELD
STEUERUNG
Goto MAINLOOP
End If
If STATUS=16
Goto MAINLOOP
End If
End If
Procedure EINSTELLUNG[SOUND]
Shared SCHALTER(),STATUS
OPTION_MAIN:
Unpack 13 To 0 : Screen Hide : Limit Mouse 0,0 To 450,320
Reserve Zone 16 : Reset Zone : Restore
For I=1 To 16
Read SCHALTER(I)
If I>13 Then I2=127
Set Zone I,45+I2,SCHALTER(I) To 54+I2,SCHALTER(I)+9
Next I
Ink 0,5 : STATUS=-1
OPTION_1:
For Y=1 To 10
Gosub OPTION_2
Next Y
If STATUS Then Proc BLEND
Ink 0,5 : STATUS=0
Do
Repeat : Until Mouse Key
Y=Hzone(X Mouse,Y Mouse)
Gosub OPTION_2
Loop
OPTION_2:
If Y<1 Then Return
If Y>13 Then I2=172 Else I2=45
Put Block 14,I2,SCHALTER(Y)
Repeat
If Y=1
Add MAB(1),1,1 To 4
If MAB(1)=1 : N$="Mouse " : End If
If MAB(1)=2 : N$="Cpu-Easy" : End If
If MAB(1)=3 : N$="Cpu-Medium" : End If
If MAB(1)=4 : N$="Cpu-Hard " : End If
SPMO_A=MAB(1) : Text 188,40,N$
End If
If Y=2
If Mouse Key=1
Add MAB(2),1,5 To 196
Else
Add MAB(2),-1,5 To 196
End If
N$="0000" : N2$=Str$(MAB(2))-" " : Right$(N$,Len(N2$))=N2$
STONE_A=MAB(2) : Text 188,50,Right$(N$,3)
End If
If Y=3
If Mouse Key=1
Add MAB(3),1,1 To 100
Else
Add MAB(3),-1,1 To 100
End If
N$="0000" : N2$=Str$(MAB(3))-" " : Right$(N$,Len(N2$))=N2$
If MAB(3)>99 : N$="Off " : MAB(3)=0 : TIME_A=0 : Else TIME_A=-1 : End If
ZM_A=MAB(3) :
If MAB(3)>0
Text 188,60,Right$(N$,2)+" min."
Else
Text 188,60,N$
End If
End If
If Y=4
Add MAB(4),1,1 To 4
If MAB(4)=1 : N$="Joystick " : End If
If MAB(4)=2 : N$="Cpu-Easy" : End If
If MAB(4)=3 : N$="Cpu-Medium" : End If
If MAB(4)=4 : N$="Cpu-Hard " : End If
SPMO_B=MAB(4) : Text 188,89,N$
End If
If Y=5
If Mouse Key=1
Add MAB(5),1,5 To 196
Else
Add MAB(5),-1,5 To 196
End If
N$="0000" : N2$=Str$(MAB(5))-" " : Right$(N$,Len(N2$))=N2$
STONE_B=MAB(5) : Text 188,99,Right$(N$,3)
End If
If Y=6
If Mouse Key=1
Add MAB(6),1,1 To 100
Else
Add MAB(6),-1,1 To 100
End If
N$="0000" : N2$=Str$(MAB(6))-" " : Right$(N$,Len(N2$))=N2$
If MAB(6)>99 : N$="Off " : MAB(6)=0 : TIME_B=0 : Else TIME_B=-1 : End If
ZM_B=MAB(6) :
If MAB(6)>0
Text 188,109,Right$(N$,2)+" min."
Else
Text 188,109,N$
End If
End If
If Y=7
If Mouse Key=1
Add MAB(7),1,1 To 197
Else
Add MAB(7),-1,1 To 197
End If
N$="0000" : N2$=Str$(MAB(7))-" " : Right$(N$,Len(N2$))=N2$
If MAB(7)>196 : N$="Off" : MAB(7)=0 : End If
SWP_AB=MAB(7) : Text 188,139,Right$(N$,3)
End If
If Y=8
Add MAB(8),1,1 To 2
If MAB(8)=1 : N$="Tradition" Else N$="Marathon " : End If
SPIELART=MAB(8) : Text 188,149,N$
End If
If Y=9
Add MAB(9),1,1 To 2
If MAB(9)=1 : N$="One" Else N$="Two" : End If
SPIELER=MAB(9) : Text 188,159,N$
End If
If Y=10
Add MAB(10),1,1 To 3
If MAB(10)=1 : N$="Music" : End If
If MAB(10)=2 : N$="Sfx " : End If
If MAB(10)=3 : N$="Off" : End If
Text 188,169,N$
End If
If Y=11
MA=Rnd(37) : MB=Rnd(37) : PUN_A=0 : PUN_B=0
ZS_A=0 : ZS_B=0 : ABXY2$="" : ABXY$=""
For I=1 To 14
For I2=1 To 14
HF$(I,I2,1)="O"
Next I2
Next I
STATUS=Y : Fade 2 : Wait 32 : Pop Proc
End If
If Y=12
MAB(1)=0 : MAB(2)=4 : MAB(3)=101
MAB(4)=0 : MAB(5)=4 : MAB(6)=101
MAB(7)=198 : MAB(8)=2 : MAB(9)=2 : MAB(10)=3
Repeat : Until Mouse Key=0
Put Block 15,I2,SCHALTER(Y)
Goto OPTION_1
End If
If Y=13
STATUS=Y : Fade 2 : Wait 32 : Pop Proc
End If
If Y=14
TIME_A=0 : TIME_B=0
STONE_A=RAB(0) : STONE_B=RAB(1) : ZM_A=0 : ZM_B=0 : ZS_A=0 : ZS_B=0
SWP_AB=RAB(2) : MAB(7)=RAB(2) : SPIELART=RAB(3) : SPIELER=RAB(4) : SPMO_A=0
PUN_A=RAB(7) : PUN_B=RAB(8) : MA=RAB(5)-1 : MB=RAB(6)-1 : STEINANZAHL=0
ABXY$="" : STATUS=Y : Fade 2 : Wait 32 : Pop Proc
End If
If Y=15
STATUS=Y : DISK=0 : Fade 2 : Wait 32 : Pop Proc
End If
If Y=16
If SOUND=1
For I=50 To 0 Step -1 : Mvolume I : Wait 3 : Next I
Music Off
End If
Fade 3 : Wait 50 : Erase 3 : Erase 5 : Erase 15 : Erase 16 : System
End If
If Not STATUS Then Wait 6
Until Mouse Key=0
Put Block 15,I2,SCHALTER(Y)
Return
Data 32,42,52,81,91,101,131,141,151,161,190,200,210,190,200,210
End Proc
Procedure STEUERUNG
RAB(0)=MAB(2) : RAB(1)=MAB(5) : RAB(2)=MAB(7) : RAB(3)=MAB(8)
RAB(4)=MAB(9) : RAB(5)=MA : RAB(6)=MB
If TIME_A or TIME_B Then Every 40 Proc ZEIT : Every On
Do
If SPMO_A=1 and SPIELER=1
Repeat
A$=Inkey$
If Asc(A$)>0
If Asc(A$)=27 or Asc(A$)=115 : FIN=-1 : End If
If Asc(A$)=104 : Proc HELFE_MIR : X=CX*16 : Y=CY*16 : Exit : End If
If A$=Chr$(112) : Proc PAUSE : End If
End If
Exit If FIN,2
X=X Screen(X Mouse) : Y=Y Screen(Y Mouse)
Until Mouse Key
X=X/16*16/16 : Y=Y/16*16/16
XALT=X*16 : YALT=Y*16
Proc SETZE_STEIN[X,Y]
End If
If SPMO_A>1 and SPIELER=1
A$=Inkey$
If A$<>""
If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If
If A$=Chr$(112) : Proc PAUSE : End If
End If
Exit If FIN
Proc CPU_THINK
Proc MAUSMOVE[CX*16,CY*16]
Proc SETZE_STEIN[CX,CY]
End If
If SPMO_B=1 and SPIELER=2
X=XALT/16 : Y=YALT/16
Repeat
A$=Inkey$
If Asc(A$)>0
If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If
If Asc(A$)=104 : Proc HELFE_MIR : X=CX : Y=CY : Exit : End If
If A$=Chr$(112) : Proc PAUSE : End If
End If
Exit If FIN,2
If Jleft(1) and X>1 : Dec X : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If
If Jright(1) and X<14 : Inc X : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If
If Jup(1) and Y>1 : Dec Y : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If
If Jdown(1) and Y<14 : Inc Y : Proc MAUSMOVE[X*16,Y*16] : Wait 1 : End If
Until Fire(1)=-1
Proc SETZE_STEIN[X,Y]
End If
If SPMO_B>1 and SPIELER=2
A$=Inkey$
If A$<>""
If A$=Chr$(27) or Asc(A$)=115 : FIN=-1 : End If
If A$=Chr$(112) : Proc PAUSE : End If
End If
Exit If FIN
Proc CPU_THINK
Proc MAUSMOVE[CX*16,CY*16]
Proc SETZE_STEIN[CX,CY]
End If
Loop
Every Off
Clear Key
ABXY$=ABXY$+"*" : ABXY2$=ABXY$ : RAB(7)=PUN_A : RAB(8)=PUN_B
If Asc(A$)=0
Proc FINITO
Proc STATISTIK
End If
If Asc(A$)=27
Proc FINITO
End If
If Asc(A$)=115
Proc TILES[98,2,259,35,45]
Wait Key : Del Cblock
Screen Close 1
Fade 2 : Wait 32
DISK=-1
Proc LADE_SPIELFELD
Fade 2 : Wait 32
Pop Proc
End If
Proc URSPRUNG
End Proc
Procedure SPIELFELD
Unpack 15 To 0 : Screen Hide
Limit Mouse 149,63 To 358,271
Proc KLEIN_A : Proc KLEIN_B
N$="000" : Right$(N$,Len(Str$(ZM_A)-" "))=Str$(ZM_A)-" "
A$="000" : Right$(A$,Len(Str$(ZM_B)-" "))=Str$(ZM_B)-" "
For I=2 To 3
If ZM_A or ZS_A : Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,76 : End If
If ZM_B or ZS_B : Put Block 1+Val(Mid$(A$,I,1)),281+(I-1)*5,172 : End If
Next I
N$="000" : Right$(N$,Len(Str$(ZS_A)-" "))=Str$(ZS_A)-" "
A$="000" : Right$(A$,Len(Str$(ZS_B)-" "))=Str$(ZS_B)-" "
For I=2 To 3
If ZS_A or ZM_A : Put Block 1+Val(Mid$(N$,I,1)),296+(I-1)*5,76 : End If
If ZS_B or ZM_B : Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,172 : End If
Next I
N$="00000" : Right$(N$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
A$="00000" : Right$(A$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
For I=1 To 5
Put Block 1+Val(Mid$(N$,I,1)),281+I*5,83
Put Block 1+Val(Mid$(A$,I,1)),281+I*5,179
Next I
N$="000000" : Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
A$="000000" : Right$(A$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
For I=2 To 6
Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,90
Put Block 1+Val(Mid$(A$,I,1)),281+(I-1)*5,186
Next I
STEINANZAHL=0
For I=1 To 14
For I2=1 To 14
HF$(I,I2,0)=HF$(I,I2,1)
If HF$(I,I2,0)<>"O"
If HF$(I,I2,0)="A" : Put Block 11,I*16+1,I2*16+1 : Inc STEINANZAHL : End If
If HF$(I,I2,0)="B" : Put Block 12,I*16+1,I2*16+1 : Inc STEINANZAHL : End If
If HF$(I,I2,0)="V" : Put Block 16,I*16-1,I2*16-1 : Inc STEINANZAHL : End If
Else
HF$(I,I2,0)="O"
End If
Next I2
Next I
If SPIELER=1 Then Put Block 11,278,217 Else Put Block 12,278,217
X Mouse=X Hard(21) : Y Mouse=Y Hard(21) : XALT=16 : YALT=16
Proc BLEND
Unpack 16 To 1
Screen To Front 0 : Screen 0
If SPMO_A>0 Then Proc TILES[0,70,161,103,45] Else Proc TILES[162,36,290,69,62]
Colour 16,$FFF : Colour 17,$FFF : Colour 18,$FFF
Wait Key
If MAB(10)=2 Then Sam Play 3,3,8300 : Wait 40
Put Cblock 1,45,109 : Del Cblock
End Proc
Procedure KLEIN_A
Add MA,1,1 To 38 : Ink 0
For I=1 To 3
For I2=1 To 3
Inc L
If Mid$(KF$(MA),L,1)="S"
Put Block 11,245+I2*16,1+I*16
Else
Bar 245+I2*16,1+I*16 To 253+I2*16,10+I*16
End If
Next I2
Next I
End Proc
Procedure KLEIN_B
Add MB,1,1 To 38 : Ink 0
For I=1 To 3
For I2=1 To 3
Inc L
If Mid$(KF$(MB),L,1)="S"
Put Block 12,245+I2*16,97+I*16
Else
Bar 245+I2*16,97+I*16 To 253+I2*16,106+I*16
End If
Next I2
Next I
End Proc
Procedure SETZE_STEIN[X,Y]
If X>14 or X<1 or Y>14 or Y<1 Then Pop Proc
If HF$(X,Y,0)<>"O" and Asc(HF$(X,Y,0))<>0 Then Pop Proc
If MAB(10)=2 Then Sam Play 2,2,28000
N$="00000"
If SPIELER=1
Put Block 11,X*16+1,Y*16+1
HF$(X,Y,0)="A"
Dec STONE_A : Right$(N$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
For I=1 To 5
Put Block 1+Val(Mid$(N$,I,1)),281+I*5,83
Next I
Proc TESTFELD
Put Block 12,278,217
If STONE_B=0 : FIN=-1 : End If
SPIELER=2
Else
Put Block 12,X*16+1,Y*16+1
HF$(X,Y,0)="B"
Dec STONE_B : Right$(N$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
For I=1 To 5
Put Block 1+Val(Mid$(N$,I,1)),281+I*5,179
Next I
Proc TESTFELD
Put Block 11,278,217
If STONE_A=0 : FIN=-1 : End If
SPIELER=1
End If
Inc STEINANZAHL
If SWP_AB Then Proc TAUSCHE_AB
If STEINANZAHL=196 Then FIN=-1
If STEINANZAHL>140 Then Proc CHANCE_CROWN
ABXY$=ABXY$+Chr$(X+64)+Chr$(Y+64)
End Proc
Procedure TESTFELD
Every Off
Repeat
If SPIELER=1 Then A$="A" : N$=KF$(MA) Else A$="B" : N$=KF$(MB)
STATUS=0
For I=1 To 12
For I2=1 To 12
W=Asc(HF$(I2,I,0))
If W=Asc(A$) or W=80
A=0
For L=0 To 2
For L2=0 To 2
Inc A : W=Asc(HF$(I2+L2,I+L,0))
If Mid$(N$,A,1)="S" and W=Asc(A$) or W=80
N2$=N2$+"S"
Else
N2$=N2$+"O"
End If
Next L2
Next L
A=0
If N2$=N$
For L=0 To 2
For L2=0 To 2
Inc A
If Mid$(N$,A,1)="S"
Put Block 13,(I2+L2)*16+1,(I+L)*16+1
HF$(I2+L2,I+L,0)="P" : STATUS=-1
End If
Next L2
Next L
A=0
End If
N2$=""
End If
Next I2
Next I
If STATUS
For I=1 To 14
For I2=1 To 14
If HF$(I,I2,0)="P"
If SPIELART=1 : L2=10 : HF$(I,I2,0)="V" Else L2=5 : HF$(I,I2,0)="O" : Dec STEINANZAHL : End If
If MAB(10)=2 : Sam Play 1,1,9800 : End If
For L=0 To L2
Wait 3
Screen Copy 1,162+L*13,70,175+L*13,82 To 0,I*16-1,I2*16-1
Next L
If L2=5 : Wait 5 : Plot I*16+5,I2*16+5,0 : End If
N$="00000" : A$=N$
If SPIELER=1
Inc STONE_A
For A=1 To 5
Right$(A$,Len(Str$(STONE_A)-" "))=Str$(STONE_A)-" "
Put Block 1+Val(Mid$(A$,A,1)),281+A*5,83
Next A
If ABXY2$=""
Add PUN_A,25 : N$="000000" : A$=N$
For A=2 To 6
Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
Put Block 1+Val(Mid$(N$,A,1)),281+(A-1)*5,90
Next A
End If
Else
Inc STONE_B
For A=1 To 5
Right$(A$,Len(Str$(STONE_B)-" "))=Str$(STONE_B)-" "
Put Block 1+Val(Mid$(A$,A,1)),281+A*5,179
Next A
If ABXY2$=""
Add PUN_B,25 : N$="000000" : A$=N$
For A=2 To 6
Right$(N$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
Put Block 1+Val(Mid$(N$,A,1)),281+(A-1)*5,186
Next A
End If
End If
End If
Next I2
Next I
If SPIELER=1 : Proc KLEIN_A Else KLEIN_B : End If
End If
Until STATUS=0
Repeat : Until Mouse Key=0
If TIME_A or TIME_B Then Every 40 Proc ZEIT
End Proc
Procedure TAUSCHE_AB
Dec SWP_AB
If SWP_AB Then Pop Proc
For I=1 To 14
For I2=1 To 14
If HF$(I,I2,0)<"C"
If HF$(I,I2,0)="A"
Put Block 12,I*16+1,I2*16+1
HF$(I,I2,0)="B"
Else
If HF$(I,I2,0)="B"
Put Block 11,I*16+1,I2*16+1
HF$(I,I2,0)="A"
End If
End If
End If
Next I2
Next I
SWP_AB=MAB(7)
SPIELER_ALT=SPIELER
SPIELER=1 : Proc TESTFELD
SPIELER=2 : Proc TESTFELD
SPIELER=SPIELER_ALT
End Proc
Procedure CHANCE_CROWN
For I=1 To 12
For I2=1 To 12
For L=0 To 2
For L2=0 To 2
Inc A : X=Asc(HF$(I+L2,I2+L,0))
If Mid$(KF$(MA),A,1)="S" and(X=65 or X=79) Then Inc W
If Mid$(KF$(MB),A,1)="S" and(X=66 or X=79) Then Inc Z
Next L2
Next L
If W=5 or Z=5 Then Pop Proc
W=0 : Z=0 : A=0
Next I2
Next I
NOCROWN=-1 : FIN=-1
End Proc
Procedure ZEIT
N$="000" : A$="000"
If SPIELER=1 and TIME_A
Add ZS_A,-1,-1 To 59
If ZS_A=-1 and ZM_A>0
Dec ZM_A : ZS_A=59
End If
Right$(N$,Len(Str$(ZM_A)-" "))=Str$(ZM_A)-" "
Right$(A$,Len(Str$(ZS_A)-" "))=Str$(ZS_A)-" "
For I=2 To 3
Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,76
Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,76
Next I
If PUN_A>0
Dec PUN_A : N$="000000"
Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
For I=2 To 6
Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,90
Next I
End If
If ZM_A=0 and ZS_A=0 : TIME_A=0 : FIN=-1 : End If
End If
If SPIELER=2 and TIME_B
Add ZS_B,-1,-1 To 59
If ZS_B=-1 and ZM_B>0
Dec ZM_B : ZS_B=59
End If
Right$(N$,Len(Str$(ZM_B)-" "))=Str$(ZM_B)-" "
Right$(A$,Len(Str$(ZS_B)-" "))=Str$(ZS_B)-" "
For I=2 To 3
Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,172
Put Block 1+Val(Mid$(A$,I,1)),296+(I-1)*5,172
Next I
If PUN_B>0
Dec PUN_B : N$="000000"
Right$(N$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
For I=2 To 6
Put Block 1+Val(Mid$(N$,I,1)),281+(I-1)*5,186
Next I
End If
If ZM_B=0 and ZS_B=0 : TIME_B=0 : FIN=-1 : End If
End If
Every On
End Proc
Procedure PAUSE
Every Off
Proc TILES[0,2,97,35,77]
Wait Key : Clear Key
If MAB(10)=2 Then Sam Play 3,3,8300 : Wait 40
Put Cblock 1,45,109 : Del Cblock
Colour 16,$FFF : Colour 17,$FFF : Colour 18,$FFF
If TIME_A or TIME_B Then Every 40 Proc ZEIT
End Proc
Procedure FINITO
Proc TILES[0,36,161,69,45]
Wait Key
Fade 2 : Wait 32
Del Cblock : Screen Close 1
End Proc
Procedure STATISTIK
Unpack 14 To 0 : Screen Hide : Hide
Ink 5 : Bar 45,45 To 275,200
Def Scroll 1,0,0 To 320,100,0,28 : Scroll 1
Def Scroll 1,0,100 To 320,220,0,-28 : Scroll 1
Ink 0,5 : Bar 0,191 To 320,220
Text 122,85,"Statistics"
Text 78,115,"Player 1 - Player 2"
N$="000000" : A$="000000"
Right$(N$,Len(Str$(PUN_A)-" "))=Str$(PUN_A)-" "
Right$(A$,Len(Str$(PUN_B)-" "))=Str$(PUN_B)-" "
Text 158,133,":" : Text 86,133,N$ : Text 190,133,A$
If PUN_A>PUN_B Then Text 65,165,"The winner is Player 1 !"
If PUN_B>PUN_A Then Text 65,165,"The winner is Player 2 !"
If PUN_A=PUN_B Then Text 112,165,"A full draw !"
Proc BLEND
Repeat : Until Mouse Key or Fire(1)
Fade 2 : Wait 32 : Show
End Proc
Procedure CPU_THINK
Randomize Timer
If SPIELER=1 and MAB(1)>1 and MAB(1)<4
Z=Rnd(10)
If MAB(1)=2
If Z>7 : Goto LETZTE_HILFE : End If
If Z>3 : Goto SPIELER_MUSTER : End If
End If
If MAB(1)=3
If Z>5 : Goto SPIELER_MUSTER : End If
End If
End If
If SPIELER=2 and MAB(4)>1 and MAB(4)<4
Z=Rnd(10)
If MAB(4)=2
If Z>7 : Goto LETZTE_HILFE : End If
If Z>3 : Goto SPIELER_MUSTER : End If
End If
If MAB(4)=3
If Z>5 : Goto SPIELER_MUSTER : End If
End If
End If
GEGNER_MUSTER:
Z2=-1
If SPIELER=1
If PUN_A-PUN_B>125 : Goto SPIELER_MUSTER : End If
Else
If PUN_B-PUN_A>125 : Goto SPIELER_MUSTER : End If
End If
GEGNER_MUSTER_II:
If SPIELER=1 Then A$="B" : N$=KF$(MB) Else A$="A" : N$=KF$(MA)
For I=1 To 12
For I2=1 To 12
A=0 : Z=0 : W=0
For L=0 To 2
For L2=0 To 2
Inc A
If Mid$(N$,A,1)="S"
If HF$(I+L2,I2+L,0)=A$ : Inc Z : End If
If HF$(I+L2,I2+L,0)="O" : W=-1 : End If
End If
Next L2
Next L
If Z>3 and W
Repeat
Z=Rnd(8)+1
If Mid$(N$,Z,1)="S"
A=0
For L=0 To 2
For L2=0 To 2
Inc A
If Mid$(N$,A,1)="S" and Asc(HF$(I+L2,I2+L,0))=79
CX=I+L2 : CY=I2+L
End If
Next L2
Next L
End If
Until CX
Pop Proc
End If
Next I2
Next I
If Z2=0 Then Goto LETZTE_HILFE
SPIELER_MUSTER:
If SPIELER=1 Then A$="A" : N$=KF$(MA) Else A$="B" : N$=KF$(MB)
W_ALT=0 : CX=0 : CY=0 : A=0 : W=0 : TEST=0
For I=1 To 12
For I2=1 To 12
For L=0 To 2
For L2=0 To 2
If HF$(I+L2,I2+L,0)=A$ Then TEST=-1 : L=2 : L2=2
Next L2
Next L
If TEST
TEST=0
For L=0 To 2
For L2=0 To 2
Inc A
If Mid$(N$,A,1)="S"
If HF$(I+L2,I2+L,0)=A$ : Inc Z : Inc W : End If
If HF$(I+L2,I2+L,0)="O" : Inc Z : End If
End If
Next L2
Next L
If Z=5 and W>W_ALT
W_ALT=W : I_ALT=I : I2_ALT=I2
End If
A=0 : W=0 : Z=0
End If
Next I2
Next I
If W_ALT
W=0
Repeat
Z=Rnd(8)+1
If Mid$(N$,Z,1)="S"
For L=0 To 2
For L2=0 To 2
Inc A : Inc W : If W>1764 : Z2=0 : Goto LETZTE_HILFE : End If
If A=Z and Asc(HF$(I_ALT+L2,I2_ALT+L,0))=79
CX=I_ALT+L2 : CY=I2_ALT+L
End If
Next L2
Next L
A=0
End If
Until CX
Pop Proc
End If
LETZTE_HILFE:
If Z2
Z2=0
If MAB(1)=1 or MAB(1)=4 and SPIELER=1 : Goto GEGNER_MUSTER_II : End If
If MAB(4)=1 or MAB(4)=4 and SPIELER=2 : Goto GEGNER_MUSTER_II : End If
End If
If SPIELER=1 Then X=65 : N$=KF$(MA) Else X=66 : N$=KF$(MB)
Z=Rnd(1) : If Z=0 Then Z2=12 : Z3=1 : W=-1 Else Z2=1 : Z3=12 : W=1
For I=Z2 To Z3 Step W
For I2=Z2 To Z3 Step W
A=0 : Z=0
For L=0 To 2
For L2=0 To 2
Inc A
Y=Asc(HF$(I+L2,I2+L,0))
If Mid$(N$,A,1)="S" and(Y=X or Y=79) : Inc Z : End If
Next L2
Next L
If Z=5
Repeat
Z=Rnd(8)+1
If Mid$(N$,Z,1)="S"
For L=0 To 2
For L2=0 To 2
If HF$(I+L2,I2+L,0)="O"
CX=I+L2 : CY=I2+L : Pop Proc
End If
Next L2
Next L
End If
Until True=0
End If
Next I2
Next I
Repeat
CX=Rnd(13)+1 : CY=Rnd(13)+1
Until HF$(CX,CY,0)="O"
End Proc
Procedure HELFE_MIR
Proc CPU_THINK
Proc MAUSMOVE[CX*16,CY*16]
Clear Key
End Proc
Procedure REPLAY
Do
A$=Inkey$
If A$<>""
If Asc(A$)=27 : Exit : End If
If Asc(A$)=112 : Proc PAUSE : End If
End If
Inc I : X=Asc(Mid$(ABXY2$,I,1))-64
Inc I : Y=Asc(Mid$(ABXY2$,I,1))-64
Exit If X<1 or Y<1
Proc MAUSMOVE[X*16,Y*16]
Proc SETZE_STEIN[X,Y]
Loop
Clear Key
ABXY$=ABXY2$
MAB(2)=RAB(0) : MAB(5)=RAB(1) : MAB(7)=RAB(2)
MAB(8)=RAB(3) : MAB(9)=RAB(4)
Proc FINITO
Proc URSPRUNG
End Proc
Procedure MAUSMOVE[L,L2]
If L<XALT Then I2=-1 Else I2=1
For I=XALT To L Step I2
X Mouse=X Hard(I)+5 : For A=1 To 100 : Next A
Next I
If L2<YALT Then I2=-1 Else I2=1
For I=YALT To L2 Step I2
Y Mouse=Y Hard(I)+5 : For A=1 To 100 : Next A
Next I
XALT=L : YALT=L2
End Proc
Procedure LADE_SPIELFELD
Shared SCHALTER(),FILE$(),STATUS
Unpack 14 To 0 : Screen Hide : Limit Mouse 0,0 To 450,300
Reserve Zone 16 : Reset Zone : Restore
Ink 4,5
Gosub LESEN
For I=1 To 9
Set Zone I,71,43+I*10 To 271,49+I*10
Next I
Set Zone 10,46,50 To 60,96
Set Zone 11,46,97 To 60,143
Set Zone 12,67,155 To 272,169
For I=1 To 4
Read SCHALTER(I)
Set Zone I+12,SCHALTER(I),189 To SCHALTER(I)+9,198
Next I
Def Scroll 1,70,52 To 272,142,0,-1
Def Scroll 2,70,52 To 272,142,0,1
Ink 4,5
If DISK Then Text 59,197,"Load" Else Text 114,197,"Save"
Z=1
Proc BLEND
Do
Repeat : Until Mouse Key
Y=Hzone(X Mouse,Y Mouse)
If Y=13 and DISK or Y=14 and DISK=0 Then Y=0
If Y>12 Then Put Block 14,SCHALTER(Y-12),189
Ink 4,5
If Y>0 and Y<10 and Instr(FILE$(Y+Z-1),Chr$(160))=0
N$=FILE$(Y+Z-1)-".dat"
Ink 0,1 : Text 71,49+Y*10,N$+Space$(25-Len(N$))
Ink 4,5 : Text 71,165,N$+Space$(25-Len(N$))
Repeat : Until Mouse Key=0
Text 71,49+Y*10,N$+Space$(25-Len(N$))
End If
If Y=10 and Z+8<Z2
For I=1 To 10 : Scroll 1 : Wait Vbl : Next I
Text 71,139,FILE$(Z+9)-".dat" : Inc Z
End If
If Y=11 and Z>1
For I=1 To 10 : Scroll 2 : Wait Vbl : Next I
Dec Z : Text 71,59,FILE$(Z)-".dat"
End If
If Y=12
Text 71,165,String$("_",25)
N$="" : Clear Key
Repeat
A$=""
While A$="" : A$=Inkey$ : Wend
If Asc(A$)<33 and Asc(A$)<>8 and Asc(A$)<>13 : A$="_" : End If
If Len(N$)<25 and Asc(A$)<>8 and Asc(A$)<>13 and Asc(A$)<160 : N$=N$+A$ : End If
If Asc(A$)=8 and Len(N$)>0 : N$=Left$(N$,Len(N$)-1) : End If
Text 71,165,N$+String$("_",25-Len(N$))
Until Asc(A$)=13
Text 71,165,N$+Space$(25-Len(N$)) : Clear Key
End If
If Y=13 and DISK=0 and Mouse Key
If Exist(N$+".dat")=True
Open In 1,N$+".dat"
For I=1 To 9
Input #1,MAB(I)
Next I
Input #1,MA
Input #1,MB
Input #1,ZM_A
Input #1,ZS_A
Input #1,PUN_A
Input #1,ZM_B
Input #1,ZS_B
Input #1,PUN_B
I=0
While Not Eof(1)
Input #1,N$
Inc I
For I2=1 To 14
HF$(I,I2,1)=Mid$(N$,I2,1)
Next I2
Wend
Close 1
RAB(0)=MAB(2) : RAB(1)=MAB(5) : RAB(2)=MAB(7) : RAB(3)=MAB(8)
RAB(4)=MAB(9) : RAB(5)=MA : RAB(6)=MB
SPMO_A=MAB(1) : SPMO_B=MAB(4) : STONE_A=MAB(2) : ZM_A=MAB(3)
STONE_B=MAB(5) : ZM_B=MAB(6) : SWP_AB=MAB(7) : SPIELART=MAB(8) : SPIELER=MAB(9)
If ZM_A or ZS_A : TIME_A=-1 Else TIME_A=0 : End If
If ZM_B or ZS_B : TIME_B=-1 Else TIME_B=0 : End If
ABXY$="" : ABXY2$="" : STATUS=Y : Fade 2 : Wait 32 : Pop Proc
Else
If DISK=0 : A$=" File not found...."+Space$(14) : Proc LAUFSCHRIFT[A$,228] : End If
End If
End If
If Y=14 and DISK and Len(N$)>0 and Z2<50
If Exist(N$+".dat")=0 : Inc Z2 : FILE$(Z2)=N$ : Gosub LESEN : End If
Open Out 1,N$+".dat"
Print #1,MAB(1)
Print #1,STONE_A
Print #1,ZM_A
Print #1,MAB(4)
Print #1,STONE_B
Print #1,ZM_B
Print #1,MAB(7)
Print #1,MAB(8)
Print #1,SPIELER
Print #1,MA-1
Print #1,MB-1
Print #1,ZM_A
Print #1,ZS_A
Print #1,PUN_A
Print #1,ZM_B
Print #1,ZS_B
Print #1,PUN_B
For I=1 To 14
N$=""
For I2=1 To 14
N$=N$+HF$(I,I2,0)
Next I2
Print #1,N$
Next I
Close 1
Else
If Y=14 and DISK
A$=" No File selected...."+Space$(10) : Proc LAUFSCHRIFT[A$,236]
End If
End If
If Y=15
If Exist(N$+".dat")
Kill N$+".dat"
I=Match(FILE$(0),N$+".dat")
FILE$(I)=Chr$(160)
Gosub LESEN
Else
A$=" File not found...."+Space$(14) : Proc LAUFSCHRIFT[A$,228]
End If
End If
If Y=16 Then Fade 2 : Wait 32 : Proc URSPRUNG : STATUS=Y : Pop Proc
If Y>12 Then Put Block 15,SCHALTER(Y-12),189
Loop
LESEN:
Z2=0 : Z=1
Sort FILE$(0)
Repeat : Inc Z2 : Until FILE$(Z2)=Chr$(160) or Z2>49 : Dec Z2
For I=1 To 9 : Text 71,49+I*10,FILE$(I)-".dat"+Space$(25-Len(FILE$(I)-".dat")) : Next I
Return
Data 46,102,158,230
End Proc
Procedure INFO
Unpack 14 To 0 : Screen Hide : Hide
Proc URSPRUNG
Ink 5 : Bar 45,45 To 275,200
Ink 0,5
Text 138,60,"Paragon"
Text 41,90,"Amos by.....: Fran"+Chr$(231)+"ois Lionet"
Text 41,105,"Tested by...: Karsten Blank"
Text 41,120,"Idea by.....: Volker Stepprath"
Text 41,135,"Written by..: Volker Stepprath"
Text 161,157,"*"
Text 53,178,"Amos © 1990 Mandarin / Jawx"
Text 37,193,"Paragon © 1991 Depeche Software"
Proc BLEND
Repeat : Until Mouse Key
Fade 2 : Wait 32 : Show
End Proc
Procedure BLEND
Screen Clone 1 : Screen To Front 0 : Auto View Off
For I=1 To 16 : Colour I,0 : Next I : Screen Show
View : Auto View On : Fade 2 To 1 : Wait 32 : Screen Close 1
End Proc
Procedure URSPRUNG
Dec MAB(1) : Inc MAB(2) : Inc MAB(3)
Dec MAB(4) : Inc MAB(5) : Inc MAB(6)
Inc MAB(7) : Dec MAB(8) : Dec MAB(9) : Dec MAB(10)
End Proc
Procedure TILES[X,Y,X2,Y2,Z]
Get Cblock 1,45,109,170,33
For I=1 To 4 : Colour I+7,$FFF : Next I
Screen Copy 1,X,Y,X2,Y2 To 0,Z,109
If NOCROWN
Ink 10 : Bar 52,115 To 197,132
Ink 8,10 : Text 79,123,"NO CHANCE TO"
Text 63,133,"COMPLETE A CROWN"
End If
Wait 10
Fade 3 To 1 : Wait 64
End Proc
Procedure LAUFSCHRIFT[A$,L]
Def Scroll 3,1,230 To 320,242,-1,0 : Ink 1,0
Repeat : Until Mouse Key=0
For X=1 To L
If I2=0
Text 311,239,Mid$(A$,I,1)
Add I,1,1 To Len(A$)
End If
If Mouse Key=0 Then Wait Vbl
Scroll 3 : Add I2,1,0 To 7
Next X
Repeat : Until Mouse Key
For X=1 To 320 : Scroll 3 : Next X
End Proc
Procedure GAMES_GFX_TO_RAM
Unpack 16 To 0 : Screen Hide
Colour 2,$B9B : Colour 3,$979 : Colour 4,$868
For I=0 To 9
Get Block 1+I,162+I*3,84,3,5,1
Next I
For I=0 To 2
Get Block 11+I,162+I*9,90,9,9,1
Next I
Get Block 14,189,90,11,11,1
Get Block 15,200,90,11,11,1
Get Block 16,292,70,13,13,1
Change Mouse 2
Hide : Music 1
Screen Open 1,320,200,8,Lowres
Flash Off : Curs Off : Change Mouse 2
For I=1 To 4 : Colour I,$0 : Next I
Cls 0 : Screen Copy 0,0,104,181,231 To 1,68,26
Screen Copy 0,183,104,280,130 To 1,58,154 : Screen Copy 0,183,130,280,149 To 1,164,154
Wait 20 : Fade 3 To 0 : Wait 320 : Fade 3 : Wait 70
Cls 0 : Screen Copy 0,183,150,280,172 To 1,115,100 : Fade 3 To 0 : Wait 180 : Fade 3 : Wait 70
Cls 0 : Screen Copy 0,183,172,311,192 To 1,100,100 : Fade 3 To 0 : Wait 240 : Fade 3 : Wait 70
Cls 0 : Ink 1,0 : Text 80,120,"checking for games..." : Fade 3 To 0 : Wait 50
For I=1 To 50 : FILE$(I)=Chr$(160) : Next I : I=0
F$=Dir First$("*.*")
While F$<>"" and I<51
If Instr(F$,".dat")
F$=Left$(F$,Len(F$-" ")-2) : F$=Right$(F$,Len(F$)-1)
Inc I : FILE$(I)=F$
End If
F$=Dir Next$
Wend
For I=1 To 38
Read KF$(I)
Next I
Fade 3 : Wait 50 : Show
Screen Close 1 : Screen Close 0
Data "SOOSSSOOS","SOOSOOSSS","SSOSSOOOS","SOSSSOSOO","SOOSSSSOO","SSSSOOSOO"
Data "SSOOSOOSS","SOOOSOSSS","SSOOSOSOS","SSSOOSOOS","SSOOSSOOS","SSOOOSSSO"
Data "SOSSSOOSO","SSOSOSOOS","SOOSSSOSO","SOSSOSOSO","SSOSOSSOO","SSSSOOOSO"
Data "SSOOSSOSO","SOOOSSOSS","SOSOSOSSO","SSSOSOOOS","SOSOSSOSO","SOOOSSSOS"
Data "SOOSOSSSO","SSOSOOOSS","SOOSSOSOS","SOSSSOOOS","SOOSOSOSS","SOOSSOOSS"
Data "SOOOSSSSO","SSSOSOOSO","SSOOOSOSS","SSSOOSOSO","SOSOSOOSS","SOSOSSOOS"
Data "SSOOSSSOO","SOSOSOSOS"
End Proc